home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / 0B.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  21KB  |  929 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #include "hdr.h"
  11. #include "vars.h"
  12. #include "dbxp.h"
  13. #include "errmsgp.h"
  14. #include "dclmapp.h"
  15. #include "miscp.h"
  16. #include "smiscp.h"
  17. #include "chapp.h"
  18. #include <ctype.h>
  19. /* ctype.h needed for isupper, tolower, etc in 4.2 bsd*/
  20.  
  21. void adasem(Node node)                                            /*;adasem*/
  22. {
  23.     /* This is the driver routine for  all semantic processing. It is called
  24.      * by  the parser  whenever the syntax    tree  for a compilation unit has
  25.      * been built. The input  to this routine  is an AST node,  on which two
  26.      * maps are defined : AST, and SPANS. These maps are global to the front
  27.      * end.
  28.      */
  29.  
  30.     Node    n1, n2, n3, n4;
  31.     char    *id, *op_id;
  32.     Fortup    ft1;
  33.     Tuple    tup;
  34.     Node    decl_node, id_node, l;
  35.     Symbol    package, s1;
  36.  
  37.     if (cdebug2 > 2) {
  38.         /*    TO_ERRFILE("node type ");*/
  39. #ifdef IBM_PC
  40.         printf("node type: %s %d %p\n", kind_str(N_KIND(node)), N_KIND(node),
  41.           node);
  42. #else
  43.         printf("node type: %s %d %ld\n", kind_str(N_KIND(node)), N_KIND(node),
  44.           node);
  45. #endif
  46.     }
  47.  
  48.     /* The current node is placed in a global variable, from which the error
  49.      * routines can extract its span.
  50.      */
  51.     current_node = node;
  52.  
  53. #ifdef DEBUG
  54.     if (trapns>0 && N_SEQ(node) == trapns && N_UNIT(node) == trapnu)trapn(node);
  55. #endif
  56.     switch(N_KIND(node)) {
  57.  
  58.     /* Chapter 2. Lexical elements*/
  59.  
  60.     /* pragma  ->  [as_pragma  identifier argument_list]*/
  61.     case(as_pragma):
  62.         process_pragma(node);
  63.         break;
  64.  
  65.     /* argument_association     ->  [as_arg  identifier  expression]*/
  66.     case(as_arg):
  67.         break;            /*Unpacked in process_pragmas.*/
  68.  
  69.     /* Chapter 3. Declarations and types */
  70.  
  71.     /*  object_declaration ->  [as_obj_decl    identifier_list subtype_indic
  72.      *                            opt_expression]
  73.      */
  74.     case(as_obj_decl):
  75.         obj_decl(node);
  76.         break;
  77.  
  78.     /* const_declaration  ->  ['const_decl' identifier_list subtype_indic
  79.      *                            opt_expression]
  80.      */
  81.     case(as_const_decl):
  82.         const_decl(node);
  83.         break;
  84.  
  85.     /* num_declaration    ->  ['num_decl'  identifier_list expression]*/
  86.     case(as_num_decl):
  87.         number_decl(node);
  88.         break;
  89.  
  90.     /* type_decl  ->  ['type_decl' identifier discriminant_list
  91.      *                            type_definition]
  92.      */
  93.     case(as_type_decl):
  94.         type_decl(node);
  95.         break;
  96.  
  97.     /* Subtype_decl ->  ['subtype_decl' identifier subtype_indic]*/
  98.     case(as_subtype_decl):
  99.         subtype_decl(node);
  100.         break;
  101.  
  102.     /* subtype_indication  ->  ['subtype_indic', name opt_constraint]*/
  103.     case(as_subtype_indic):
  104.         /*[name, opt_constraint] := N_AST(node);*/
  105.         adasem(N_AST1(node));
  106.         adasem(N_AST2(node));
  107.         break;
  108.  
  109.     /* derived_type_definition  -> ['derived_type'    subtype_indication]*/
  110.     case(as_derived_type):
  111.         break;
  112.  
  113.     /* discrete_range  ->  ['range' expression  expression]*/
  114.     case(as_range):
  115.         /*[expression1, expression2] := N_AST(node);*/
  116.         adasem(N_AST1(node));
  117.         adasem(N_AST2(node));
  118.         break;
  119.  
  120.     /* range_attribute ->  ['range_attribute' name range]*/
  121.     case(as_range_attribute):
  122.         N_KIND(node) = as_attribute;
  123.         n2 = N_AST3(node);
  124.         find_old(node);
  125.         adasem(n2);
  126.         break;
  127.  
  128.     /* discrete_range  ->  ['range_expression'  expression]*/
  129.     case(as_range_expression):
  130.         adasem(N_AST1(node));
  131.         break;
  132.  
  133.     /* constraint  ->  ['constraint'  general_aggregate]*/
  134.     case(as_constraint):
  135.         sem_list(node);
  136.         break;
  137.  
  138.     /* enumeration_type  -> [as_enum  enumeration_literal_list]*/
  139.     case(as_enum):
  140.         sem_list(node);
  141.         break;
  142.  
  143.     case(as_int_type):
  144.         break;
  145.  
  146.     case(as_float_type):
  147.         break;
  148.  
  149.     case(as_fixed_type):
  150.         break;
  151.  
  152.     case(as_digits):
  153.     case(as_delta):
  154.         adasem(N_AST1(node));
  155.         adasem(N_AST2(node));
  156.         break;
  157.  
  158.     /* array_type_definition -> ['array_type' index_list subtype_indication]*/
  159.     case(as_array_type):
  160.         array_typedef(node);
  161.         break;
  162.  
  163.     /* subtype_definition  ->  ['box'  name]*/
  164.     case(as_box):
  165.         adasem(N_AST1(node));
  166.         break;
  167.  
  168.     /* discrete_range -> [as_subtype opt_name  range_constraint]
  169.      * general_component_association ->[as_subtype opt_name range-constraint]
  170.      */
  171.     case(as_subtype):
  172.         /*[opt_name, range_constraint] := N_AST(node);*/
  173.         n1 = N_AST1(node);
  174.         n2 = N_AST2(node);
  175.         if (n1 != OPT_NODE) {
  176.             adasem(n1);
  177.             find_old(n1);
  178.         }
  179.         if (n2 == OPT_NODE) {    /* possible, if syntax error */
  180.             N_KIND(node) = as_name;
  181.         }
  182.         else adasem(n2);
  183.         break;
  184.  
  185.     /* record_decl    -> [as_record component_list]*/
  186.     case(as_record):
  187.         adasem(N_AST1(node));
  188.         break;
  189.  
  190.     /* component_list  -> [ 'component_list'  component_decl_list variant]*/
  191.     case(as_component_list):
  192.         /*[component_decl_list, variant] := N_AST(node);*/
  193.         sem_list(N_AST1(node));
  194.         adasem(N_AST2(node));
  195.         break;
  196.  
  197.     /* component_declaration -> ['field' identifier_list subtype_indic
  198.      *                             opt_expression]
  199.      */
  200.     case(as_field):
  201.         comp_decl(node);
  202.         break;
  203.  
  204.     /* discr_specification -> ['discr_spec' identifier_list name opt_expr]*/
  205.     case(as_discr_spec):
  206.         /*[id_list_node, name, opt_expr] := N_AST(node);*/
  207.         adasem(N_AST2(node));
  208.         /*  adasem(N_AST3(node));   */
  209.         break;
  210.  
  211.     /* variant_part -> ['variant_decl' simple_name variant_list]*/
  212.     case(as_variant_decl):
  213.         variant_decl(node);
  214.         break;
  215.  
  216.     /* component_association -> ['choice_list'  choice_list     expression]*/
  217.     case(as_choice_list):
  218.         /*[choice_list, expression] := N_AST(node);*/
  219.         sem_list(N_AST1(node));
  220.         adasem(N_AST2(node));
  221.         break;
  222.  
  223.     case(as_simple_choice):
  224.         adasem(N_AST1(node));
  225.         break;
  226.  
  227.     case(as_range_choice):
  228.         adasem(N_AST1(node));
  229.         break;
  230.  
  231.     case(as_others_choice):
  232.         break;
  233.  
  234.     case(as_choice_unresolved):
  235.         adasem(N_AST1(node));
  236.         break;
  237.  
  238.     case(as_access_type):
  239.         n1 = N_AST1(node);
  240.         adasem(n1);
  241.         n2 = N_AST1(n1);
  242.         n3 = N_AST2(n1);
  243.         if (n3 == OPT_NODE ) {
  244.             /*Special case: type mark may be an incomplete type.*/
  245.             N_UNQ(n1) = find_type(n2);
  246.         }
  247.         else {    /* elaborate subtype indication*/
  248.             N_UNQ(n1) = promote_subtype(make_subtype(n1));
  249.         }
  250.         break;
  251.  
  252.     /* incomplete_type_decl -> ['incomplete_decl'  identifier  discriminant]*/
  253.     case(as_incomplete_decl):
  254.         incomplete_decl(node);
  255.         break;
  256.  
  257.     /* declarations -> ['declarations'  declaration_list]*/
  258.     case(as_declarations):
  259.         declarative_part(node);
  260.         break;
  261.  
  262.     /* Chapter 4. Names and expressions */
  263.  
  264.     /* name     -> ['character_literal'   character]
  265.      * Character literals also appear as enumeration literals, and as
  266.      * selectors.
  267.      */
  268.     case(as_character_literal):
  269.         break;
  270.  
  271.     /* name      ->  ['simple_name'  identifier]*/
  272.     case(as_simple_name):
  273.         break;
  274.  
  275.     /* name      ->  ['call?'    name  general_aggregate]*/
  276.     case(as_call_unresolved):
  277.         n1 = N_AST1(node);
  278.         n2 = N_AST2(node);
  279.  
  280.         if (N_KIND(n1) == as_string) {
  281.             /* Operator designator: reduce to lower case.*/
  282.             /*N_VAL(n1) = LOWER_CASE_OF(N_VAL(n1));*/
  283.             id = N_VAL(n1);
  284.             while(*id) {
  285.                 if (isupper(*id)) *id = tolower(*id);
  286.                 id++;
  287.             }
  288.         }
  289.         adasem(n1);
  290.         FORTUP(n1 = (Node), N_LIST(n2), ft1);
  291.             adasem(n1);
  292.         ENDFORTUP(ft1);
  293.         break;
  294.  
  295.     /* name ->  ['operator'     operator_symbol]*/
  296.     case(as_operator):
  297.         N_KIND(node) = as_simple_name;
  298.         break;
  299.  
  300.     case(as_string):
  301.         N_KIND(node) = as_simple_name;
  302.         break;
  303.  
  304.     /* name     ->  ['.' name selector]*/
  305.     case(as_selector):
  306.         adasem(N_AST1(node));
  307.         break;
  308.  
  309.     case(as_all):
  310.         adasem(N_AST1(node));
  311.         break;
  312.  
  313.     case(as_attribute):
  314.         adasem(N_AST2(node));
  315.         adasem(N_AST3(node));
  316.         break;
  317.  
  318.     /* aggregate  ->  [as_aggregate expression_list]*/
  319.     case(as_aggregate):
  320.         sem_list(node);
  321.         break;
  322.  
  323.     /* parenthesised_expression  ->     ['()', expression]*/
  324.     case(as_parenthesis):
  325.         adasem(N_AST1(node) );
  326.         break;
  327.  
  328.     /* expression  ->  [operator_designator     <expression..>]*/
  329.     case(as_op):
  330.     case(as_un_op):
  331.         /*[op_node, arg_list] := N_AST(node);*/
  332.         n1 = N_AST1(node);
  333.         op_id = N_VAL(n1);
  334.         /* KLUDGE until parser fixed. */
  335.         if (streq(op_id, "NOT")) N_VAL(n1) = strjoin("not", "");
  336.         else if (streq(op_id, "AND")) N_VAL(n1) = strjoin("and", "");
  337.         else if (streq(op_id, "XOR")) N_VAL(n1) = strjoin("xor", "");
  338.         else if (streq(op_id, "REM")) N_VAL(n1) = strjoin("rem", "");
  339.         else if (streq(op_id, "MOD")) N_VAL(n1) = strjoin("mod", "");
  340.         else if (streq(op_id, "OR"))  N_VAL(n1) = strjoin("or", "");
  341.         n2 = N_AST2(node);
  342.         find_old(n1);
  343.  
  344.         FORTUP(n3 = (Node), N_LIST(n2), ft1);
  345.             adasem(n3);
  346.             /*
  347.              * the call to check_range_attribute is useless, since
  348.              * adasem converts a